home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / puma.lha / puma / src / puma.cg < prev    next >
Text File  |  1992-09-25  |  30KB  |  995 lines
  1. /* Ich, Doktor Josef Grosch, Informatiker, 21.3.1989 */
  2.  
  3. MODULE AstIn
  4.  
  5. PROPERTY INPUT
  6.  
  7. RULE
  8.  
  9. Classes        = <
  10.    NoClass    = .
  11.    Class    = [Name: tIdent] [Properties: tClassProperties]
  12.           Attributes Extensions: Classes Next: Classes REV .
  13. >.
  14. Attributes    = <
  15.    NoAttribute    = .
  16.    AttrOrAction    = Next: Attributes REV <
  17.       Child    = [Name: tIdent] [Type: tIdent] [Properties: tAttrProperties] .
  18.       Attribute    = [Name: tIdent] [Type: tIdent] [Properties: tAttrProperties] .
  19.       ActionPart= .
  20.    >.
  21. >.
  22.  
  23. END AstIn
  24.  
  25. MODULE Ast
  26.  
  27. RULE
  28.  
  29. Class        = BaseClass: Classes .
  30.  
  31. END Ast
  32.  
  33. MODULE Common
  34.  
  35. TREE IMPORT    {
  36.  
  37. FROM SYSTEM    IMPORT ADDRESS;
  38. FROM IO        IMPORT tFile;
  39. FROM Strings    IMPORT tString;
  40. FROM StringMem    IMPORT tStringRef;
  41. FROM Idents    IMPORT tIdent;
  42. FROM Texts    IMPORT tText;
  43. FROM Sets    IMPORT tSet;
  44. FROM Relations    IMPORT tRelation;
  45. FROM Positions    IMPORT tPosition;
  46.  
  47. VAR ErrorCount    : CARDINAL;
  48.  
  49. CONST
  50.  
  51.    (* properties of attributes and attribute instances        *)
  52.  
  53.    Virtual    = 0;
  54.    Computed    = 1;
  55.    Reverse    = 2;    (* list attribute to be used for reversion *)
  56.    Write    = 3;    (* Usage:                *)
  57.    Read        = 4;    (*                      *)
  58.    Inherited    = 5;    (* Kind:                *)
  59.    Synthesized    = 6;
  60.    Input    = 7;    (* Mode:                *)
  61.    Output    = 8;
  62.    Tree        = 9;    (* Store:                *)
  63.    Parameter    = 10;
  64.    Stack    = 11;
  65.    Variable    = 12;    (*    global variable            *)
  66.    Demand    = 13;
  67.    Funct    = 14;
  68.    Ignore    = 15;
  69. (* Abstract    = 16;                        *)
  70.    Thread    = 17;    (* specified thread            *)
  71.    Test        = 18;    (* generated for check            *)
  72.    Left        = 19;    (* lhs/rhs of rule (for instances)    *)
  73.    Right    = 20;    (*                    *)
  74.    CopyDef    = 21;    (* defined by copy rule            *)
  75.    CopyUse    = 22;    (* used by copy rule            *)
  76.    NonBaseComp    = 23;    (* non inherited computation        *)
  77.    MultInhComp    = 24;    (* multiple inherited computation    *)
  78.    First    = 25;    (* first attribute of group        *)
  79.    Dummy    = 26;    (* dummy attribute for complete evaluation *)
  80.    Def        = 27;    (* marks definition of attribute    *)
  81.    Use        = 28;    (* marks last use of attribute        *)
  82.    ChildUse    = 29;    (* marks last use of rhs attribute    *)
  83.    ParentUse    = 30;    (* marks last use of lhs attribute    *)
  84.    Generated    = 31;    (* action part has been generated    *)
  85.  
  86.    (* properties of classes                    *)
  87.  
  88.    Top        = 0;    (* declaration level:            *)
  89.    Intermediate    = 1;    (*                    *)
  90.    Low        = 2;    (*    (has no extensions)        *)
  91.    Referenced    = 3;    (* explicitly used            *)
  92.    Reachable    = 4;    (* reachable maybe via extensions    *)
  93.    Nonterminal    = 5;
  94.    Terminal    = 6;
  95.    Explicit    = 7;    (* class explicitely declared        *)
  96.    Implicit    = 8;    (* class implicitely declared        *)
  97.    Trace    = 9;    (*                    *)
  98.    String    = 10;    (* named by string, otherwise ident    *)
  99.    HasSelector    = 11;    (* selector explicitly specified    *)
  100.    HasChildren    = 12;    (*                    *)
  101.    HasAttributes= 13;    (*                    *)
  102.    HasActions    = 14;    (*                    *)
  103. (* Ignore    = 15;                        *)
  104.    Abstract    = 16;
  105.    Mark        = 17;
  106.    HasOutput    = 18;    (* has output attributes or tests    *)
  107. }
  108.  
  109. EXPORT    {
  110.  
  111. TYPE
  112.    INTEGER0        = SHORTCARD;
  113.    tAttrProperties    = BITSET;
  114.    tClassProperties    = BITSET;
  115.    tClass        = tTree;
  116.    ProcOfT        = PROCEDURE (tTree);
  117.  
  118. VAR
  119.    Options    : tSet;
  120.    f        : tFile;
  121.    SourceFile    : ARRAY [0..255] OF CHAR;
  122.    NoCodeAttr    ,
  123.    NoCodeClass    : BITSET;
  124.  
  125. PROCEDURE InitIdentifyClass    (t: tTree);
  126. PROCEDURE InitIdentifyClass2    (t: tTree);
  127. PROCEDURE IdentifyClass        (t: tTree; Ident: tIdent): tTree;
  128. PROCEDURE IdentifyAttribute    (t: tTree; Ident: tIdent): tTree;
  129. PROCEDURE ForallClasses        (t: tTree; Proc: ProcOfT);
  130. PROCEDURE ForallAttributes    (t: tTree; Proc: ProcOfT);
  131. PROCEDURE Error        (ErrorCode: INTEGER; Pos: tPosition);
  132. PROCEDURE Warning    (ErrorCode: INTEGER; Pos: tPosition);
  133. PROCEDURE Information    (ErrorCode: INTEGER; Pos: tPosition);
  134. PROCEDURE ErrorI    (ErrorCode: INTEGER; Pos: tPosition; iClass: INTEGER; iPtr: ADDRESS);
  135. PROCEDURE WarningI    (ErrorCode: INTEGER; Pos: tPosition; iClass: INTEGER; iPtr: ADDRESS);
  136. PROCEDURE InformationI    (ErrorCode: INTEGER; Pos: tPosition; iClass: INTEGER; iPtr: ADDRESS);
  137. PROCEDURE WI        (i: tIdent);
  138. PROCEDURE WE        (i: tIdent);
  139. PROCEDURE WN        (n: INTEGER);
  140. }
  141.  
  142. GLOBAL    {
  143.  
  144. FROM SYSTEM    IMPORT ADR, ADDRESS, TSIZE;
  145. FROM DynArray    IMPORT MakeArray;
  146. FROM IO        IMPORT tFile, StdOutput, ReadI, WriteS, WriteI, WriteC, WriteNl;
  147. FROM Strings    IMPORT tString, ArrayToString, Concatenate, Length, Char;
  148. FROM StringMem    IMPORT tStringRef, WriteString;
  149. FROM Idents    IMPORT tIdent, NoIdent, GetString, WriteIdent, MakeIdent, MaxIdent;
  150. FROM Texts    IMPORT tText, MakeText;
  151. FROM Sets    IMPORT tSet, Include, IsElement, MakeSet;
  152. FROM Relations    IMPORT tRelation, IsRelated, MakeRelation;
  153. FROM Positions    IMPORT tPosition;
  154.  
  155. IMPORT Relations, Errors;
  156.  
  157. # define beginINTEGER0(a)    a := 0;
  158. # define readINTEGER0(a)    a := IO.ReadI (yyf);
  159. # define writeINTEGER0(a)    IO.WriteI (yyf, a, 0);
  160. # define beginBOOLEAN(a)    a := FALSE;
  161. # define begintIdent(a)        a := NoIdent;
  162.  
  163. VAR IdentToClassPtr    : POINTER TO ARRAY [0..1000000] OF tTree;
  164. VAR IdentToClassSize    : LONGINT;
  165. VAR sIdentToClassSize    : tIdent;
  166.  
  167. PROCEDURE InitIdentifyClass (t: tTree);
  168.    VAR i: INTEGER;
  169.    BEGIN
  170.       IdentToClassSize := MaxIdent () + 1;
  171.       sIdentToClassSize := IdentToClassSize;
  172.       MakeArray (IdentToClassPtr, IdentToClassSize, TSIZE (tTree));
  173.       FOR i := 0 TO IdentToClassSize - 1 DO
  174.      IdentToClassPtr^ [i] := NoTree;
  175.       END;
  176.       ForallClasses (t, InitIdentifyClass2);
  177.    END InitIdentifyClass;
  178.  
  179. PROCEDURE InitIdentifyClass2 (t: tTree);
  180.    BEGIN
  181.       IdentToClassPtr^ [t^.Class.Name] := t;
  182.    END InitIdentifyClass2;
  183.  
  184. PROCEDURE IdentifyClass (t: tTree; Ident: tIdent): tTree;
  185.    BEGIN
  186.       IF Ident < sIdentToClassSize THEN RETURN IdentToClassPtr^ [Ident]; END;
  187.       RETURN NoTree;
  188.    END IdentifyClass;
  189.  
  190. PROCEDURE IdentifyAttribute (t: tTree; Ident: tIdent): tTree;
  191.    VAR attribute    : tTree;
  192.    BEGIN
  193.       LOOP
  194.      CASE t^.Kind OF
  195.      | Class:
  196.            attribute := IdentifyAttribute (t^.Class.BaseClass, Ident);
  197.            IF attribute # NoTree THEN RETURN attribute; END;
  198.            t := t^.Class.Attributes;
  199.             (* RETURN IdentifyAttribute (t^.Class.Attributes, Ident); *)
  200.      | Child:
  201.            IF t^.Child.Name = Ident THEN RETURN t; END;
  202.            t := t^.Child.Next;
  203.             (* RETURN IdentifyAttribute (t^.Child.Next, Ident); *)
  204.      | Attribute:
  205.            IF t^.Attribute.Name = Ident THEN RETURN t; END;
  206.            t := t^.Attribute.Next;
  207.             (* RETURN IdentifyAttribute (t^.Attribute.Next, Ident); *)
  208.      | ActionPart:
  209.            t := t^.ActionPart.Next;
  210.             (* RETURN IdentifyAttribute (t^.ActionPart.Next, Ident); *)
  211.      ELSE
  212.            RETURN NoTree;
  213.      END;
  214.       END;
  215.    END IdentifyAttribute;
  216.  
  217. PROCEDURE ForallClasses (t: tTree; Proc: ProcOfT);
  218.    BEGIN
  219.       WHILE t^.Kind = Class DO
  220.      Proc (t);
  221.      ForallClasses (t^.Class.Extensions, Proc);
  222.      t := t^.Class.Next;        (* ForallClasses (t^.Class.Next, Proc); *)
  223.       END;
  224.    END ForallClasses;
  225.  
  226. PROCEDURE ForallAttributes (t: tTree; Proc: ProcOfT);
  227.    BEGIN
  228.       LOOP
  229.      CASE t^.Kind OF
  230.      | Class:
  231.            ForallAttributes (t^.Class.BaseClass, Proc);
  232.            t := t^.Class.Attributes; (* ForallAttributes (t^.Class.Attributes, Proc); *)
  233.      | Child:
  234.            Proc (t);
  235.            t := t^.Child.Next;    (* ForallAttributes (t^.Child.Next, Proc); *)
  236.      | Attribute:
  237.            Proc (t);
  238.            t := t^.Attribute.Next;    (* ForallAttributes (t^.Attribute.Next, Proc); *)
  239.      | ActionPart:
  240.            Proc (t);
  241.            t := t^.ActionPart.Next;    (* ForallAttributes (t^.ActionPart.Next, Proc); *)
  242.      ELSE
  243.            RETURN;
  244.      END;
  245.       END;
  246.    END ForallAttributes;
  247.  
  248. PROCEDURE Error (ErrorCode: INTEGER; Pos: tPosition);
  249.    BEGIN
  250.       Errors.ErrorMessage (ErrorCode, Errors.Error, Pos);
  251.       INC (ErrorCount);
  252.    END Error;
  253.  
  254. PROCEDURE Warning (ErrorCode: INTEGER; Pos: tPosition);
  255.    BEGIN
  256.       Errors.ErrorMessage (ErrorCode, Errors.Warning, Pos);
  257.    END Warning;
  258.  
  259. PROCEDURE Information (ErrorCode: INTEGER; Pos: tPosition);
  260.    BEGIN
  261.       Errors.ErrorMessage (ErrorCode, Errors.Information, Pos);
  262.    END Information;
  263.  
  264. PROCEDURE ErrorI (ErrorCode: INTEGER; Pos: tPosition; iClass: INTEGER; iPtr: ADDRESS);
  265.    BEGIN
  266.       Errors.ErrorMessageI (ErrorCode, Errors.Error, Pos, iClass, iPtr);
  267.       INC (ErrorCount);
  268.    END ErrorI;
  269.  
  270. PROCEDURE WarningI (ErrorCode: INTEGER; Pos: tPosition; iClass: INTEGER; iPtr: ADDRESS);
  271.    BEGIN
  272.       Errors.ErrorMessageI (ErrorCode, Errors.Warning, Pos, iClass, iPtr);
  273.    END WarningI;
  274.  
  275. PROCEDURE InformationI (ErrorCode: INTEGER; Pos: tPosition; iClass: INTEGER; iPtr: ADDRESS);
  276.    BEGIN
  277.       Errors.ErrorMessageI (ErrorCode, Errors.Information, Pos, iClass, iPtr);
  278.    END InformationI;
  279.  
  280. PROCEDURE WI (i: tIdent); BEGIN WriteIdent (f, i); END WI;
  281.  
  282. PROCEDURE WE (i: tIdent);
  283.    VAR s: tString; Ch: CHAR; j: SHORTCARD;
  284.    BEGIN
  285.       GetString (i, s);
  286.       FOR j := 1 TO Length (s) DO
  287.          Ch := Char (s, j);
  288.          IF (Ch = '{') OR (Ch = '}') OR (Ch = '\') THEN WriteC (f, '\'); END;
  289.          WriteC (f, Ch);
  290.       END;
  291.    END WE;
  292.  
  293. PROCEDURE WN (n: INTEGER); BEGIN WriteI (f, n, 0); END WN;
  294. }
  295.  
  296. BEGIN    {
  297.    ErrorCount := 0;
  298.    MakeSet (Options, 127);
  299.    NoCodeAttr  := {Test, Dummy, Virtual, Parameter};
  300.    NoCodeClass := {Ignore, Abstract};
  301. }
  302.  
  303. PROPERTY INPUT
  304.  
  305. RULE
  306.  
  307. Codes        = [Export: tText] [Import: tText] [Global: tText]
  308.           [Local: tText] [Begin: tText] [Close: tText]
  309.           [ExportLine: tPosition] [ImportLine: tPosition] [GlobalLine: tPosition]
  310.           [LocalLine: tPosition] [BeginLine: tPosition] [CloseLine: tPosition] .
  311. Designators    = <
  312.    NoDesignator    = .
  313.    Designator    = [Selector: tIdent] [Attribute: tIdent] [Pos: tPosition]
  314.           Next: Designators REV .
  315.    Ident    = [Attribute: tIdent] [Pos: tPosition]
  316.           Next: Designators REV .
  317.    Remote    = Designators [Type: tIdent] [Attribute: tIdent] [Pos: tPosition]
  318.           Next: Designators REV .
  319.    Any        = [Code: tStringRef]
  320.           Next: Designators REV .
  321.    Anys        = Layouts
  322.           Next: Designators REV .
  323. >.
  324. Layouts        = <
  325.    NoLayout    = .
  326.    LayoutAny    = [Code: tStringRef]
  327.               Next: Layouts REV .
  328. >.
  329. Names        = <
  330.    NoName    = .
  331.    Name        = [Name: tIdent] [Pos: tPosition]
  332.           Next: Names REV .
  333. >.
  334.  
  335. END Common
  336.  
  337. MODULE Cg
  338.  
  339. TREE IMPORT    {
  340.  
  341. CONST            (* grammar classes    *)
  342.  
  343.    cLNC        = 0;    (* locally non circular *)
  344.    cWAG        = 1;    (* well defined *)
  345.    cSNC        = 2;    (* ANC, ANCAG *)
  346.    cDNC        = 3;
  347.    cLordered    = 4;
  348.    cOAG        = 5;
  349.    cSweep    = 6;
  350.    cALT        = 7;    (* APAG *)
  351.    cLAG        = 8;
  352.    cRAG        = 9;
  353.    cSAG        = 10;
  354.  
  355. TYPE
  356.    tBitInfo    = RECORD ToBit, ToAttr: SHORTCARD; END;
  357.    tBitIndex    = POINTER TO ARRAY [1 .. 1000000] OF tBitInfo;
  358.    tInstancePtr    = POINTER TO tInstances;
  359.    tSetOfRelPtr    = POINTER TO tSetOfRel;
  360.    tSetOfRel    = RECORD Relation: tRelation; Next: tSetOfRelPtr; END;
  361.    INTEGER9999    = SHORTCARD;
  362.  
  363. VAR
  364.    ClassCount    : INTEGER;
  365.    GrammarClass    : BITSET;
  366.    MaxVisit    : SHORTCARD;
  367.    SubUnit    ,
  368.    ViewName    ,
  369.    iPosition    ,
  370.    itPosition    ,
  371.    iInteger    ,
  372.    iMain    ,
  373.    iModule    ,
  374.    itTree    ,
  375.    iNoTree    : tIdent;
  376.    ModuleName    : tString;
  377.    TypeNames    ,
  378.    MaxSet    : tSet;
  379. }
  380.  
  381. EXPORT    {
  382. TYPE
  383.    tInstance    = RECORD
  384.              Selector    : tTree;
  385.              Attribute    : tTree;
  386.              Action    : tTree;
  387.              Properties    : tAttrProperties;
  388.              Order    : SHORTINT;
  389.              CopyArg    : SHORTCARD;
  390.           END;
  391.    tInstances    = ARRAY [1 .. 100000] OF tInstance;
  392.  
  393. VAR
  394.    nNoAction    ,
  395.    nNoAttribute    ,
  396.    nNoClass    ,
  397.    nNoDecl    ,
  398.    nNoDesignator,
  399.    nNoLayout    ,
  400.    nNoModule    ,
  401.    nNoName    ,
  402.    nNoPrec    ,
  403.    nNoProp    : tTree;
  404.  
  405. PROCEDURE BeginTree2;
  406. PROCEDURE IdentifyModule    (t: tTree; Ident: tIdent): tTree;
  407. PROCEDURE WriteName        (i: tInstance);
  408. PROCEDURE WriteInstance        (i: tInstance);
  409. PROCEDURE WriteDependencies    (t: tTree; r: tRelation; s: tSet);
  410. PROCEDURE WriteCyclics        (t: tTree; s: tSet);
  411. PROCEDURE WriteAttrProperties    (f: tFile; Properties: tAttrProperties);
  412. PROCEDURE WriteClassProperties    (f: tFile; Properties: tClassProperties);
  413. PROCEDURE WriteClass        (t: tTree);
  414. }
  415.  
  416. GLOBAL    {
  417.  
  418. VAR
  419.    DummySet    : tSet;
  420.    DummyRelation: tRelation;
  421.  
  422. # define begintPosition(a)    a.Line := 0; a.Column := 0;
  423. # define readtPosition(a)    a.Line := ReadI (yyf); a.Column := ReadI (yyf);
  424. # define beginINTEGER9999(a)    a := 9999;
  425. # define readINTEGER9999(a)    a := IO.ReadI (yyf);
  426. # define writeINTEGER9999(a)    WriteI (yyf, a, 0);
  427. # define beginBITSET(a)        a := {};
  428. # define writetClass(a)        yyWriteHex (a);
  429. # define begintText(a)        MakeText (a);
  430. # define begintSet(a)        a := DummySet;
  431. # define begintRelation(a)    a := DummyRelation;
  432. (* IF NOT Test *)
  433. # define writetAttrProperties(a)    WriteAttrProperties(yyf, a);
  434. # define writetClassProperties(a)    WriteClassProperties(yyf, a);
  435. (* *)
  436. (* IF Test
  437.    # define readtText(a)        yyReadHex (a);
  438.    # define writetText(a)        yyWriteHex (a);
  439.    # define puttText(a)        yyPut (a);
  440.    # define gettText(a)        yyGet (a);
  441.    # define writetSet(a)        yyWriteHex (a);
  442.    # define readtSet(a)        yyReadHex (a);
  443.    # define puttSet(a)        yyPut (a);
  444.    # define gettSet(a)        yyGet (a);
  445.    # define readtRelation(a)    yyReadHex (a);
  446.    # define writetRelation(a)    yyWriteHex (a);
  447.    # define puttRelation(a)    yyPut (a);
  448.    # define gettRelation(a)    yyGet (a);
  449. *)
  450.  
  451. PROCEDURE BeginTree2;
  452.    VAR Word    : tString;
  453.    BEGIN
  454.       WITH TreeRoot^.Ag DO
  455.      IF ParserName = NoIdent THEN
  456.         ArrayToString ("Parser"    , Word); ParserName    := MakeIdent (Word);
  457.      END;
  458.      IF TreeName = NoIdent THEN
  459.         ArrayToString ("Tree"    , Word); TreeName    := MakeIdent (Word);
  460.      END;
  461.      IF EvalName = NoIdent THEN
  462.         ArrayToString ("Eval"    , Word); EvalName    := MakeIdent (Word);
  463.      END;
  464.      IF ViewName = NoIdent THEN ViewName := TreeName; END;
  465.      GetString (TreeName, ModuleName);
  466.      iMain := TreeName;
  467.       END;
  468.       ArrayToString ("t" , Word); Concatenate (Word, ModuleName); itTree  := MakeIdent (Word);
  469.       ArrayToString ("No", Word); Concatenate (Word, ModuleName); iNoTree := MakeIdent (Word);
  470.       ArrayToString ("Position"        , Word); iPosition    := MakeIdent (Word);
  471.       ArrayToString ("tPosition"    , Word); itPosition    := MakeIdent (Word);
  472.  
  473.       IF SubUnit = NoIdent THEN
  474.      iModule := iMain;
  475.       ELSE
  476.      iModule := SubUnit;
  477.      Include (Options, ORD ('<'));
  478.       END;
  479.    END BeginTree2;
  480.  
  481. PROCEDURE IdentifyModule (t: tTree; Ident: tIdent): tTree;
  482.    VAR module    : tTree;
  483.    BEGIN
  484.       IF t^.Kind = Module THEN
  485.      IF t^.Module.Name = Ident THEN RETURN t; END;
  486.      RETURN IdentifyModule (t^.Module.Next, Ident);
  487.       ELSE
  488.      RETURN NoTree;
  489.       END;
  490.    END IdentifyModule;
  491.  
  492. PROCEDURE WriteInstance (i: tInstance);
  493.    BEGIN
  494.       WITH i DO
  495.          WriteS  (StdOutput, " ");
  496.      WriteName (i);
  497.      WriteS  (StdOutput, "    ");
  498.      WriteI  (StdOutput, Attribute^.Child.Partition, 0);
  499.      WriteS  (StdOutput, " ");
  500.      WriteAttrProperties (StdOutput, Properties + Attribute^.Child.Properties);
  501.      WriteNl (StdOutput);
  502.       END;
  503.    END WriteInstance;
  504.  
  505. PROCEDURE WriteName (i: tInstance);
  506.    BEGIN
  507.       WITH i DO
  508.      IF (Selector # NoTree) AND (Right IN Properties) THEN
  509.         WriteIdent (StdOutput, Selector^.Child.Name);
  510.         WriteS     (StdOutput, ":");
  511.      END;
  512.  
  513.      IF Attribute # NoTree THEN
  514.         WriteIdent (StdOutput, Attribute^.Child.Name);
  515.      END;
  516.       END;
  517.    END WriteName;
  518.  
  519. PROCEDURE WriteAttrProperties (f: tFile; Properties: tAttrProperties);
  520.    BEGIN
  521.       IF Virtual    IN Properties THEN WriteS (f, "Virtual "    ); END;
  522.       IF Computed    IN Properties THEN WriteS (f, "Computed "    ); END;
  523.       IF Reverse    IN Properties THEN WriteS (f, "Reverse "    ); END;
  524.       IF Write        IN Properties THEN WriteS (f, "Write "    ); END;
  525.       IF Read        IN Properties THEN WriteS (f, "Read "    ); END;
  526.       IF Inherited    IN Properties THEN WriteS (f, "Inherited "    ); END;
  527.       IF Synthesized    IN Properties THEN WriteS (f, "Synthesized "    ); END;
  528.       IF Input        IN Properties THEN WriteS (f, "Input "    ); END;
  529.       IF Output        IN Properties THEN WriteS (f, "Output "    ); END;
  530.       IF Tree        IN Properties THEN WriteS (f, "Tree "    ); END;
  531.       IF Parameter    IN Properties THEN WriteS (f, "Parameter "    ); END;
  532.       IF Stack        IN Properties THEN WriteS (f, "Stack "    ); END;
  533.       IF Variable    IN Properties THEN WriteS (f, "Variable "    ); END;
  534.       IF Demand        IN Properties THEN WriteS (f, "Demand "    ); END;
  535.       IF Funct        IN Properties THEN WriteS (f, "Function "    ); END;
  536.       IF Ignore        IN Properties THEN WriteS (f, "Ignore "    ); END;
  537.       IF Thread        IN Properties THEN WriteS (f, "Thread "    ); END;
  538.       IF Test        IN Properties THEN WriteS (f, "Test "    ); END;
  539.       IF Left        IN Properties THEN WriteS (f, "Left "    ); END;
  540.       IF Right        IN Properties THEN WriteS (f, "Right "    ); END;
  541.       IF CopyDef    IN Properties THEN WriteS (f, "CopyDef "    ); END;
  542.       IF CopyUse    IN Properties THEN WriteS (f, "CopyUse "    ); END;
  543.       IF NonBaseComp    IN Properties THEN WriteS (f, "NonBaseComp "    ); END;
  544.       IF MultInhComp    IN Properties THEN WriteS (f, "MultInhComp "    ); END;
  545.       IF First        IN Properties THEN WriteS (f, "First "    ); END;
  546.       IF Dummy        IN Properties THEN WriteS (f, "Dummy "    ); END;
  547.       IF Def        IN Properties THEN WriteS (f, "Def "    ); END;
  548.       IF Use        IN Properties THEN WriteS (f, "Use "    ); END;
  549.       IF ChildUse    IN Properties THEN WriteS (f, "ChildUse "    ); END;
  550.       IF ParentUse    IN Properties THEN WriteS (f, "ParentUse "    ); END;
  551.       IF Generated    IN Properties THEN WriteS (f, "Generated "    ); END;
  552.    END WriteAttrProperties;
  553.  
  554. PROCEDURE WriteClassProperties (f: tFile; Properties: tClassProperties);
  555.    BEGIN
  556.       IF Top        IN Properties THEN WriteS (f, "Top "    ); END;
  557.       IF Intermediate    IN Properties THEN WriteS (f, "Intermediate "    ); END;
  558.       IF Low        IN Properties THEN WriteS (f, "Low "    ); END;
  559.       IF Referenced    IN Properties THEN WriteS (f, "Referenced "    ); END;
  560.       IF Reachable    IN Properties THEN WriteS (f, "Reachable "    ); END;
  561.       IF Nonterminal    IN Properties THEN WriteS (f, "Nonterminal "    ); END;
  562.       IF Terminal    IN Properties THEN WriteS (f, "Terminal "    ); END;
  563.       IF Explicit    IN Properties THEN WriteS (f, "Explicit "    ); END;
  564.       IF Implicit    IN Properties THEN WriteS (f, "Implicit "    ); END;
  565.       IF Trace        IN Properties THEN WriteS (f, "Trace "    ); END;
  566.       IF String        IN Properties THEN WriteS (f, "String "    ); END;
  567.       IF HasSelector    IN Properties THEN WriteS (f, "HasSelector "    ); END;
  568.       IF HasChildren    IN Properties THEN WriteS (f, "HasChildren "    ); END;
  569.       IF HasAttributes    IN Properties THEN WriteS (f, "HasAttributes "    ); END;
  570.       IF HasActions    IN Properties THEN WriteS (f, "HasActions "    ); END;
  571.       IF Abstract    IN Properties THEN WriteS (f, "Abstract "    ); END;
  572.       IF Mark        IN Properties THEN WriteS (f, "Mark "    ); END;
  573.       IF HasOutput    IN Properties THEN WriteS (f, "HasOutput "    ); END;
  574.    END WriteClassProperties;
  575.  
  576. PROCEDURE WriteDependencies (t: tTree; r: tRelation; s: tSet);
  577.    VAR i, j, k, count    : SHORTCARD;
  578.    BEGIN
  579.       IF (t = NoTree) OR (r.Size1 # t^.Class.InstCount) THEN RETURN; END;
  580.       WriteIdent (StdOutput, t^.Class.Name);
  581.       WriteS (StdOutput, "    ");
  582.       WriteClassProperties (StdOutput, t^.Class.Properties);
  583.       WriteNl (StdOutput);
  584.       WriteNl (StdOutput);
  585.       FOR i := 1 TO t^.Class.InstCount DO
  586.          IF IsElement (i, s) AND NOT (Dummy IN t^.Class.Instance^ [i].Properties) THEN
  587.             WriteName (t^.Class.Instance^ [i]);
  588.             WriteS    (StdOutput, "    :");
  589.         count := 0;
  590.         k := 0;
  591.             FOR j := 1 TO t^.Class.InstCount DO
  592.            IF IsElement (j, s) AND IsRelated (i, j, r) THEN
  593.           IF count = 5 THEN
  594.              WriteNl (StdOutput);
  595.              WriteS  (StdOutput, "    ");
  596.              count := 0;
  597.           END;
  598.           WriteS    (StdOutput, " ");
  599.           WriteName (t^.Class.Instance^ [j]);
  600.           INC (count);
  601.           INC (k);
  602.            END;
  603.             END;
  604.         WriteS (StdOutput, " (");
  605.         WriteI (StdOutput, k, 0);
  606.         WriteS (StdOutput, ")");
  607.             WriteNl (StdOutput);
  608.          END;
  609.       END;
  610.       WriteNl (StdOutput);
  611.    END WriteDependencies;
  612.  
  613. PROCEDURE WriteCyclics        (t: tTree; s: tSet);
  614.    VAR i, count    : SHORTCARD;
  615.    BEGIN
  616.       count := 0;
  617.       FOR i := 1 TO t^.Class.InstCount DO
  618.      IF IsElement (i, s) THEN
  619.         IF count = 5 THEN
  620.            WriteNl (StdOutput);
  621.            count := 0;
  622.         END;
  623.         WriteName (t^.Class.Instance^ [i]);
  624.         WriteS    (StdOutput, " ");
  625.         INC (count);
  626.          END;
  627.       END;
  628.       WriteNl (StdOutput);
  629.    END WriteCyclics;
  630.  
  631. PROCEDURE WriteClass (t: tTree);
  632.    VAR i    : SHORTCARD;
  633.    BEGIN
  634.       CASE t^.Kind OF
  635.       | Class    : WITH t^.Class DO
  636.         WriteIdent    (StdOutput, Name);
  637.         WriteS    (StdOutput, " =");
  638.         WriteNl    (StdOutput);
  639.         ForallAttributes (t, WriteClass);
  640.         WriteNl    (StdOutput);
  641.         FOR i := 1 TO InstCount DO
  642.            WITH Instance^ [i] DO
  643.           IF Action # ADR (Action) THEN
  644.              IF Test IN Properties THEN
  645.             WriteName (Instance^ [i]);
  646.             WriteS    (StdOutput, ":");
  647.              END;
  648.              WriteS    (StdOutput, "    {");
  649.              WriteClass    (Action);
  650.              WriteS    (StdOutput, "}");
  651.              WriteNl    (StdOutput);
  652.           END;
  653.            END;
  654.         END;
  655.         WriteS    (StdOutput, ".");
  656.         WriteNl    (StdOutput);
  657.      END;
  658.       | Child    : WITH t^.Child DO
  659.         WriteS    (StdOutput, "    ");
  660.         WriteIdent    (StdOutput, Name);
  661.         WriteS    (StdOutput, ": ");
  662.         WriteIdent    (StdOutput, Type);
  663.         WriteNl    (StdOutput);
  664.      END;
  665.       | Attribute    : WITH t^.Attribute DO
  666.         WriteS    (StdOutput, "    [");
  667.         WriteIdent    (StdOutput, Name);
  668.         WriteS    (StdOutput, ": ");
  669.         WriteIdent    (StdOutput, Type);
  670.         WriteS    (StdOutput, "]");
  671.         WriteNl    (StdOutput);
  672.      END;
  673.       | Assign    : WITH t^.Assign DO
  674.         WriteClass    (Results);
  675.         WriteS    (StdOutput, ":=");
  676.         WriteClass    (Arguments);
  677.         WriteS    (StdOutput, ";");
  678.      END;
  679.       | Copy    : WITH t^.Copy DO
  680.         WriteClass    (Results);
  681.         WriteS    (StdOutput, " :- ");
  682.         WriteClass    (Arguments);
  683.         WriteS    (StdOutput, ";");
  684.      END;
  685.       | TargetCode    : WITH t^.TargetCode DO
  686.         IF Results^.Kind # NoDesignator THEN
  687.            WriteClass (Results);
  688.            WriteS      (StdOutput, ":= {");
  689.            WriteClass (Code);
  690.            WriteS      (StdOutput, "};");
  691.         END;
  692.      END;
  693.       | Order    : WITH t^.Order DO
  694.         WriteClass    (Results);
  695.         WriteS    (StdOutput, " AFTER ");
  696.         WriteClass    (Arguments);
  697.         WriteS    (StdOutput, ";");
  698.      END;
  699.       | Check    : WITH t^.Check DO
  700.         IF Condition # NoTree THEN
  701.            WriteS      (StdOutput, "CHECK ");
  702.            WriteClass (Condition);
  703.         END;
  704.         IF Statement # NoTree THEN
  705.            WriteS      (StdOutput, " => { ");
  706.            WriteClass (Statement);
  707.            WriteS      (StdOutput, "}");
  708.         END;
  709.         WriteClass    (Actions);
  710.         WriteS    (StdOutput, ";");
  711.      END;
  712.       | Designator    : WITH t^.Designator DO
  713.         WriteIdent    (StdOutput, Selector);
  714.         WriteS    (StdOutput, ":");
  715.         WriteIdent    (StdOutput, Attribute);
  716.         WriteClass    (Next);
  717.      END;
  718.       | Ident    : WITH t^.Ident DO
  719.         WriteIdent    (StdOutput, Attribute);
  720.         WriteClass    (Next);
  721.      END;
  722.       | Remote    : WITH t^.Remote DO
  723.         WriteS    (StdOutput, "REMOTE ");
  724.         WriteClass    (Designators);
  725.         WriteS    (StdOutput, "=>");
  726.         WriteIdent    (StdOutput, Type);
  727.         WriteS    (StdOutput, ":");
  728.         WriteIdent    (StdOutput, Attribute);
  729.         WriteClass    (Next);
  730.      END;
  731.       | Any    : WITH t^.Any DO
  732.         WriteString    (StdOutput, Code);
  733.         WriteClass    (Next);
  734.      END;
  735.       | Anys    : WITH t^.Anys DO
  736.         WriteClass    (Layouts);
  737.         WriteClass    (Next);
  738.      END;
  739.       | LayoutAny    : WITH t^.LayoutAny DO
  740.         WriteString    (StdOutput, Code);
  741.         WriteClass    (Next);
  742.      END;
  743.       ELSE
  744.       END;
  745.    END WriteClass;
  746. }
  747.  
  748. BEGIN    {
  749.    MakeSet    (DummySet, 0);
  750.    MakeRelation    (DummyRelation, 0, 0);
  751.  
  752.    nNoAction    := mNoAction    (); 
  753.    nNoAttribute    := mNoAttribute    (); 
  754.    nNoClass    := mNoClass    (); 
  755.    nNoDecl    := mNoDecl    (); 
  756.    nNoDesignator:= mNoDesignator();
  757.    nNoLayout    := mNoLayout    (); 
  758.    nNoModule    := mNoModule    (); 
  759.    nNoName    := mNoName    (); 
  760.    nNoPrec    := mNoPrec    (); 
  761.    nNoProp    := mNoProp    (); 
  762. }
  763.  
  764. PROPERTY INPUT
  765.  
  766. RULE
  767.  
  768. Ag        = [Name: tIdent]
  769.           [ScannerName    : tIdent]
  770.           [ParserName    : tIdent] ParserCodes: Codes
  771.           [TreeName    : tIdent] TreeCodes  : Codes
  772.           [EvalName    : tIdent] EvalCodes  : Codes
  773.           Precs Props Decls Classes Modules .
  774. Precs        = <
  775.    NoPrec    = .
  776.    Prec        = Names Next: Precs REV <
  777.       LeftAssoc    = .
  778.       RightAssoc= .
  779.       NonAssoc    = .
  780.    >.
  781. >.
  782. Class        = [Selector: tIdent] [Pos: tPosition] [Code: SHORTCARD] [Prec: tIdent] Names .
  783. Child        = [Pos: tPosition] .
  784. Attribute    = [Pos: tPosition] .
  785. ActionPart    = Actions .
  786.  
  787. Actions        = <
  788.    NoAction    = .
  789.    Action    = Next: Actions REV [Pos: tPosition] <
  790.       Assign    = Results: Designators Arguments: Designators .
  791.       Copy    = Results: Designators Arguments: Designators .
  792.       TargetCode= Results: Designators Code: Designators .
  793.       Order    = Results: Designators Arguments: Designators .
  794.       Check    = Condition: Designators Statement: Designators Actions .
  795.    >.
  796. >.
  797. Modules        = <
  798.    NoModule    = .
  799.    Module    = [Name: tIdent] ParserCodes: Codes TreeCodes: Codes EvalCodes: Codes
  800.           Props Decls Classes Next: Modules REV .
  801. >.
  802. Props        = <
  803.    NoProp    = .
  804.    Prop        = [Properties: BITSET] Names Next: Props REV .
  805.    Select    = Names Next: Props REV .
  806. >.
  807. Decls        = <
  808.    NoDecl    = .
  809.    Decl        = Names Attributes [Properties: tClassProperties]
  810.           Next: Decls REV .
  811. >.
  812.  
  813. END Cg
  814.  
  815. MODULE Ag
  816.  
  817. TREE EXPORT    {
  818. PROCEDURE HasItem (t: tTree; Item: SHORTCARD): BOOLEAN;
  819. }
  820.  
  821. GLOBAL    {
  822. PROCEDURE HasItem (t: tTree; Item: SHORTCARD): BOOLEAN;
  823.    BEGIN
  824.       CASE t^.Kind OF
  825.       | Class:
  826.      RETURN HasItem (t^.Class.BaseClass, Item) OR HasItem (t^.Class.Attributes, Item);
  827.       | NoClass, NoAttribute:
  828.      RETURN FALSE;
  829.       ELSE
  830.      RETURN (t^.AttrOrAction.Item = Item) OR HasItem (t^.AttrOrAction.Next, Item);
  831.       END;
  832.    END HasItem;
  833.  
  834. }
  835.  
  836. RULE
  837.  
  838. Ag        = [Properties: BITSET] .
  839.  
  840. Class        = [AttrCount: SHORTCARD] [InstCount: SHORTCARD] [Instance: tInstancePtr]
  841.           [DP: tRelation] [SNC: tRelation] [DNC: tRelation] [OAG: tRelation]
  842.           [Part: tRelation] [Index: SHORTCARD] [Visits: SHORTCARD] [Users: tSet]
  843.           [Generated: INTEGER0] [BitCount: SHORTCARD] [BitIndex: tBitIndex]
  844.           [D: tSetOfRelPtr] .
  845. Child        = [AttrIndex: SHORTCARD] [Partition: INTEGER9999] [Usage: BITSET]
  846.           [InstOffset: SHORTCARD] [Class: tClass] [ParsIndex: SHORTCARD]
  847.           [BitOffset: SHORTCARD] .
  848. Attribute    = [AttrIndex: SHORTCARD] [Partition: INTEGER9999] [Usage: BITSET] .
  849. ActionPart    = [Name: SHORTCARD] [ParsIndex: SHORTCARD] [Properties: BITSET] .
  850.  
  851. AttrOrAction    = [Item: SHORTCARD] .
  852.  
  853. Check        = Results: Designators .
  854.  
  855. Module        = [Properties: BITSET] .
  856.  
  857. END Ag
  858.  
  859. MODULE PumaIn
  860.  
  861. PROPERTY INPUT
  862.  
  863. RULE
  864.  
  865. Spec        = [TrafoName: tIdent] TreeNames Public: Names Extern: Names Codes Routines .
  866.  
  867. TreeNames    = <
  868.    NoTreeName    = .
  869.    TreeName    = [Name: tIdent] [Pos: tPosition] Next: TreeNames REV .
  870. >.
  871. Routines    = <
  872.    NoRoutine    = .
  873.    Routine    = Next: Routines REV [Name: tIdent] [Pos: tPosition] InParams: Parameters
  874.           OutParams: Parameters Extern: Names [Local: tText] [LocalLine: tPosition]
  875.           Rules <
  876.       Procedure    = .
  877.       Function    = ReturnParams: Parameters .
  878.       Predicate    = .
  879.    >.
  880. >.
  881. Parameters    = <
  882.    NoParameter    = .
  883.    Param    = [IsRef: BOOLEAN] [Name: tIdent] [Pos: tPosition] Type Next: Parameters REV .
  884. >.
  885. Type        = [Name: tIdent] [Pos: tPosition] Names .
  886.  
  887. Rules        = <
  888.    NoRule    = .
  889.    Rule        = [Line: tPosition] Patterns Exprs Expr Statements Next: Rules REV .
  890. >.
  891. Patterns    = <
  892.    NoPattern    = [Pos: tPosition] .
  893.    OnePattern    = Pattern Next: Patterns REV .
  894. >.
  895. PatternsList        = <
  896.    NoPatternsList    = .
  897.    OnePatternsList    = Patterns Next: PatternsList .
  898. >.
  899. Pattern        = [Pos: tPosition] <
  900.    Decompose    = [Selector: tIdent] Expr Patterns [Widen: BOOLEAN] .
  901.    VarDef    = [Name: tIdent] .
  902.    NilTest    = [Selector: tIdent] .
  903.    DontCare1    = .
  904.    DontCare    = .
  905.    Value    = Expr .
  906. >.
  907. Exprs        = <
  908.    NoExpr    = [Pos: tPosition] .
  909.    OneExpr    = Expr Next: Exprs REV <
  910.       NamedExpr    = [Name: tIdent] .
  911.    >.
  912. >.
  913. Expr        = [Pos: tPosition] <
  914.    Compose    = [Selector: tIdent] Expr Exprs [Widen: BOOLEAN] .
  915.    VarUse    = [Name: tIdent] <
  916.       AttrDesc    = [Attribute: tIdent] .
  917.    >.
  918.    Nil        = [Selector: tIdent] .
  919.    Call        = Expr Exprs Patterns .
  920.    Binary    = Lop: Expr [Operator: tIdent] Rop: Expr .
  921.    PreOperator    = [Operator: tIdent] Expr .
  922.    PostOperator    = [Operator: tIdent] Expr .
  923.    Index    = Expr Exprs .
  924.    Parents    = Expr .
  925.    TargetExpr    = Expr: Designators .
  926.    StringExpr    = [String: tStringRef] .
  927. >.
  928. Statements     = <
  929.    NoStatement     = .
  930.    Statement     = [Pos: tPosition] Next: Statements REV <
  931.       ProcCall     = Call .
  932.       Condition     = Expr .
  933.       Assignment = Adr: Expr Expr .
  934.       Reject     = .
  935.       Fail     = .
  936.       TargetStmt = Parameters Stmt: Designators .
  937.       Nl     = .
  938.       WriteStr     = [String: tStringRef] .
  939.    >.
  940. >.
  941.  
  942. Formals        = <
  943.    NoFormal    = .
  944.    Formal    = Next: Formals REV [Name: tIdent] TypeDesc Path .
  945.    DummyFormal    = Next: Formals .
  946. >.
  947. TypeDesc    = <
  948.    NodeTypes    = TreeName [Types: tSet] .
  949.    UserType    = [Type: tIdent] .
  950. >.
  951. Path        = <
  952.    Var        = [Name: tIdent] [IsOutput: BOOLEAN] [IsRegister: BOOLEAN] .
  953.    ConsType    = Next: Path [Name: tIdent] .
  954.    Field    = Next: Path [Name: tIdent] .
  955. >.
  956. Tests        = <
  957.    NoTest    = .
  958.    OneTest    = Next: Tests Path <
  959.       TestKind    = TypeDesc: NodeTypes [Name: tIdent] .
  960.       TestIsType= TypeDesc: NodeTypes [Name: tIdent] .
  961.       TestNil    = .
  962.       TestNonlin= Path2: Path TypeDesc .
  963.       TestValue    = Expr TypeDesc .
  964.    >.
  965. >.
  966. Decisions    = <
  967.    NoDecision    = .
  968.    Decision    = Then: Decisions Else: Decisions OneTest [Cases: SHORTCARD] [IsUnchanged: BOOLEAN] .
  969.    Decided    = Else: Decisions Rule .
  970. >.
  971.  
  972. END PumaIn
  973.  
  974. MODULE Puma
  975.  
  976. DECLARE
  977.  
  978. TreeName    = Classes [ClassCount: SHORTCARD] .
  979.  
  980. Name Compose Decompose VarDef VarUse Call Assignment Designator = [Object: tClass] .
  981. Pattern Compose        = [Tempo: tIdent] TypeDesc .
  982. TargetExpr TargetStmt    = [UsedNames: tSet] .
  983.  
  984. Class        = Formals TypeDesc [Index: SHORTCARD] .
  985. Routine        = InForm: Formals OutForm: Formals ParamDecls: Formals [IsExtern: BOOLEAN] .
  986. Routine        = Decisions .
  987. Function    = ReturnForm: Formals .
  988. Rule        = VarDecls: Formals [HasTempos: BOOLEAN] [HasPatterns: BOOLEAN] [Tempo: tIdent] [Index: SHORTCARD] .
  989. Rule        = Tests [HasExit: BOOLEAN] [HasAssign: BOOLEAN] [HasTargetCode: BOOLEAN] [HasRejectOrFail: BOOLEAN] .
  990. Pattern        = Path .
  991. DontCare    = Tempos: Formals .
  992. AttrDesc Designator    = [Type: tIdent] .
  993.  
  994. END Puma
  995.